home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
wildcat
/
qwkhold1.zip
/
QWK2HOLD.WCC
< prev
next >
Wrap
Text File
|
1996-05-17
|
31KB
|
709 lines
'QWK_ASK.WCC by James Mardis (FidoNet 1:322/746) 5/7/96
'
'This program allows callers to turn on/off the QWK Prescan feature as
'well as download any existing QWK mail packets currently on hold.
'It is used with the companion programs LOGON2.WCC and QWK2MAKE.WCC.
'
'You may Freely modify this program as long as you do NOT charge for
'it's use in this form or the modified form. This program is in the
'public domain. This program carries no Warranty, Guarantee whatsover.
'You use this program at your own risk. The original Author shall NOT
'be held responsible for any damages whatsoever as to the result or use
'of this program. After all, It is in the public Domain and is subject
'to change without the knowledge of the Author (James Mardis).
'
'The configuration file, QWK2HOLD.CFG breaks down as follows:
'Line #1, Complete PathName where WCMAIL QWK stores mail packets,
' such as C:\WILDCAT\MAIL\QWK\
'
'Line #2, File area number for QWK Mail that was choosen in the Makewild
' QWK Mail area.
'
'Line #3, Complete PathName where QWK2 can store all user mail packets.
'
'Line #4, Valid values are COMMENT(1) thru COMMENT(5) exactly as shown.
' The right and left parentheses around the number are
' manditory.
'
' The actual value found in the user's COMMENT(?) field will
' contain either QWK2 ON XX or QWK2 OFF XX where XX equals
' the number of mail packets that are currently in storage.
' The XX field must begin at character 10 in the comment field.
'
'Line #5, Security Profile #1 to exclude from operating this program.
' I use this to bar NEWUSER from this program
' while allowing them access to other WCX programs.
' If not used set it to NO SEC1.
'
'Line #6, Security Profile #2 to exclude from operating this program.
' If not used set it at NO SEC2.
'
'Line #7 Maximum number of QWK packets a caller can have waiting for pickup.
' Valid values are 1 to 26.
'
'Line #8 Maximum number of days to keep stored QWK packets.
' Valid values are 1 to 365.
'
'Line #9 Maximum allowed storage space for user packets in bytes, but
' a minimum of 1 packet is allowed regardless of this value.
' Valid values are 1 to 2147483647, this is in bytes like
' what you see when listing a DOS directory from DOS.
'
'Line #10 Conference number where user messages are to be sent.
' Messages will be sent with the Private flag turned on.
'
'Line #11 Prompt colors normal for Text and Background, leave off @ symbols.
' Default two character code is 0E.
'
'Line #12 Prompt colors normal for Highlighted Text.
' Default two character code is 0B.
'
'Line #13 Prompt colors normal for Packet size and elsewhere.
' Default two character code is 0C.
'
'Line #14 Prompt colors normal for warning messages.
' Default two character code is 0E.
'
'Line #15 Path to inbound mail flag, Where to look for QWK2MA?.FLG.
'
'Line #16 Text to display when Mail Flag #1 is found.
'
'Line #17 Text to display when Mail Flag #2 is found.
'
'Line #18 Text to display when Mail Flag #3 is found.
'
'Line #19 Text to display when Mail Flag #4 is found.
'
'Line #20 Text to display when Mail Flag #5 is found.
'
dim BadEnd as Integer 'Value to trigger program failure message.
dim ChaStr1 as String 'Junk String Variable, re-used at will.
dim ChaStr2 as String 'Junk String Variable, re-used at will.
dim CurCode as Date 'Current Date while in ddmmyyyy format.
dim CurDate as Integer 'Current date coded in DOS format.
dim CurDay as String 'Current Day while code is run.
dim CurMonth as String 'Current Month while code is run.
dim CurYear as String 'Current Year while code is run.
dim FileDos as Word 'File date in DOS code format.
dim FileNm2 as String 'Used to Open assorted files.
dim FileSearch as SearchRec 'Search record array for file info.
dim FileSize as Long 'Current file size.
dim FindQWK as Integer '"For" loop counter vailable.
dim FindUser as Integer '"For" loop counter variable.
dim MailProc1 as String 'QWK.CFG #16, Prompt for mail flag #1
dim MailProc2 as String 'QWK.CFG #17, Prompt for mail flag #2
dim MailProc3 as String 'QWK.CFG #18, Prompt for mail flag #3
dim MailProc4 as String 'QWK.CFG #19, Prompt for mail flag #4
dim MailProc5 as String 'QWK.CFG #20, Prompt for mail flag #5
dim MaxAge as Integer 'QWK2HOLD.CFG #8, Maximum # of days packets kept.
dim MaxPacket as Integer 'QWK2HOLD.CFG #7, Maximum allowed QWK packets.
dim MaxSize as Long 'QWK2HOLD.CFG #9, Maximum size of all packets.
dim MaxUser as Integer 'Total number of users in userlist.
dim MsgHd as MessageHeader 'Used to send messages.
dim MsgPlace as Integer 'QWK2HOLD.CFG #10, Conference where messages go.
dim NewFile as String 'New QWK file name.
dim NumInt1 as Integer 'Junk Integer Variable, re-used at will.
dim NumInt2 as Integer 'Junk Integer Variable, re-used at will.
dim OldAge as Integer 'Oldest number of packet days in existance.
dim OldFile as String 'Old QWK file name.
dim P1 as String 'QWK.CFG #11, Prompt #1 Color.
dim P2 as String 'QWK.CFG #12, Prompt #2 Color.
dim P3 as String 'QWK.CFG #13, Prompt #3 Color.
dim P4 as String 'QWK.CFG #14, Prompt #4 Color.
dim QWKAge as Integer 'Current age of the packet in days.
dim QWKFlag as String 'QWK2HOLD.CFG #4, QWK search variable.
dim QWKInbound as String 'QWK2HOLD.CFG #15, Path to mail flag.
dim QWKLocal as String 'Path where Sysop's local QWK packets wind up.
dim QWKRoute as String 'QWK2HOLD.CFG #3, Path to QWK2 mail packets.
dim QWKTotal as Integer 'Total number of QWK packets for user.
dim QWKLeft as Integer 'Total number of QWK packets a user has left.
dim QWKSysop as String 'Path choosen by Sysop for local transfer.
dim SecPro1 as String 'QWK2HOLD.CFG #5, Security Profile #1 restriction.
dim SecPro2 as String 'QWK2HOLD.CFG #6, Security Profile #2 restriction.
dim Size as Long 'Place to store total size of stored packets.
dim UKey as String 'Used to determine user's choice.
'dim UserRec as UserRecord 'Create temporary array for user record.
dim WCMailRoute as String 'QWK2HOLD.CFG #1, Path where WCMAIL stores packets.
dim WCMailZip as Integer 'QWK2HOLD.CFG #2, File area number used in WCMAIL.
dim QWKDown as String 'Used to determine if user wants to download QWK.
'
'Time to read in the QWK2HOLD.CFG file.
EnablePages Off ' Disable inbound page till program ends, resets at end.
FileNm2 = ProgPath + "QWK2HOLD.CFG" 'QWK2HOLD.CFG is the configuration file.
If Exists (FileNm2) then 'If QWK2HOLD.CFG exists, get data.
OPEN FileNm2 for Input as #1 'Open CFG file for reading.
If Not(local) Then CarrierCheck Off 'Ignore modem till entire file read.
LockFile (1,0,1) 'Temporary file lock for multinode use.
Input #1, WCMailRoute '#1, Path where WCMAIL stores packets.
Input #1, WCMailZip '#2, File directory # from MAKEWILD(WCMAIL).
Input #1, QWKRoute '#3, Path to QWK Mail Packets.
Input #1, QWKFlag '#4, User QWK Comment(?) action.
Input #1, SecPro1 '#5, Security Exclusion Value #1.
Input #1, SecPro2 '#6, Security Exclusion Value #2.
Input #1, MaxPacket '#7, Maximum number of user QWK Packets.
Input #1, MaxAge '#8, Maximum # of days to keep stored packets.
Input #1, MaxSize '#9, Maximum size of storage for user packets.
Input #1, MsgPlace '#10, Conference number where messages are to go.
Input #1, P1 '#11, Prompt color for normal text.
Input #1, P2 '#12, Prompt color for highlighted text.
Input #1, P3 '#13, Prompt color for Packet size.
Input #1, P4 '#14, Prompt color for Alert Messages.
Input #1, QWKInbound '#15, Path to inbound mail flag, if mail processing.
Input #1, MailProc1 '#16, Mail Processing message #1.
Input #1, MailProc2 '#17, Mail Processing message #2.
Input #1, MailProc3 '#18, Mail Processing message #3.
Input #1, MailProc4 '#19, Mail Processing message #4.
Input #1, MailProc5 '#20, Mail Processing message #5.
UnlockFile (1,0,1) 'Remove temporary file lock.
Close #1 'Close the CFG file.
If Not(Local) Then CarrierCheck On 'File read, exit if carrier dropped.
Else 'Go here if no CFG file is found.
BadEnd = 0 'Set up error message.
Goto Problem 'No CFG file was found, abort the program.
End If 'End of LOGIN2.CFG input.
If (User.SecLevel = SecPro1) or (User.SecLevel = SecPro2) Then End
'Validate read QWK2HOLD.CFG file data.
If WCMailRoute = "" Then
BadEnd = 1: Goto Problem 'WCMail Path missing, QWK2HOLD.CFG LINE #1.
Else 'WCMailroute actually contains something.
WCMailRoute = Trim(UCase(WCMailRoute)) 'Make it Uppercase & Trim spaces.
If Mid(WCMailRoute,2,2) <> ":\" Then BadEnd = 1: Goto Problem
If Right(WCMailRoute,1) <> "\" Then 'Verify path ends in a backslash.
WCMailRoute = WCMailRoute + "\" 'Slash was added.
End If 'End of WCMailRoute slash check.
End If 'End of WCMailRoute check.
If QWKRoute = "" Then
BadEnd = 2: Goto Problem 'QWKRoute missing, QWK2HOLD.CFG LINE #2.
Else 'QWKRoute actually contains something.
QWKRoute = Trim(UCase(QWKRoute)) 'Make it Uppercase & Trim spaces.
IF Mid(QWKRoute,2,2) <> ":\" Then BadEnd = 2: Goto Problem
IF Right(QWKRoute,1) <> "\" Then 'Verify path ends in backslash.
QWKRoute = QWKRoute + "\" 'Slash was added.
End If 'End of QWKRoute slash check.
End If 'End of QWKRoute check.
If QWKFlag = "" Then 'Does QWKFlag value exist in the CFG file.
BadEnd = 3: Goto Problem 'QWKFlag missing, QWK2HOLD.CFG Line #3.
Else 'QWKFlag actually contains something.
QWKFlag = UCase(QWKFlag) 'Make it Uppercase.
End If' End of If QWKFlag.
If SecPro1 = "" Then
SecPro1 = "NO SEC1" 'If no QWK2HOLD.CFG Line #5, set value.
Else 'SecPro1 actually contains something.
SecPro1 = Trim(UCase(SecPro1)) 'Make it Uppercase & Trim spaces.
End If
If SecPro2 = "" Then
SecPro2 = "NO SEC2" 'If no QWK2HOLD.CFG Line #6, set value.
Else 'SecPro2 actually contains something.
SecPro2 = Trim(UCase(SecPro2)) 'Make it Uppercase & Trim spaces.
End If
If QWKInbound = "" Then
BadEnd = 15: Goto Problem 'QWKInbound missing, QWK2HOLD.CFG LINE #15.
Else 'QWKInbound actually contains something.
QWKInbound = Trim(UCase(QWKInbound)) 'Make it Uppercase & Trim spaces.
IF Mid(QWKInbound,2,2) <> ":\" Then BadEnd = 15: Goto Problem
IF Right(QWKInbound,1) <> "\" Then 'Verify path ends in backslash.
QWKInbound = QWKInbound + "\" 'Slash was added.
End If 'End of QWKInbound slash check.
End If 'End of QWKInbound check.
If MaxPacket <= 0 Then MaxPacket = 1 'Minimum value is 1.
If MaxPacket >= 26 Then MaxPacket = 26 'Had to set a limit somewhere.
If MaxAge <= 0 Then MaxAge = 0 'Keep the old packets forever.
If MaxAge >= 365 Then MaxAge = 365 'Maximum life of packets is 1 year.
If MaxSize <= 0 Then MaxSize = 2147483647 'If zero, set limit at highest.
If MaxSize >= 2147483647 Then MaxSize = 2147483647 'Set maximum size limit.
If P1 = "" or Len(P1) <> 2 Then 'Check prompt P1, normal text.
P1 = "@0E@" 'Set default prompt.
Else P1 = "@" + UCase(P1) + "@"
End If
If P2 = "" or Len(P2) <> 2 Then 'Check prompt P2, highlighted text.
P2 = "@0F@" 'Set default prompt.
Else P2 = "@" + UCase(P2) + "@"
End If
If P3 = "" or Len(P3) <> 2 Then 'Check prompt P3, Packet sizes.
P3 = "@0B@" 'Set default prompt.
Else P3 = "@" + UCase(P3) + "@"
End If
If P4 = "" or Len(P4) <> 2 Then 'Check prompt P4, alert text.
P4 = "@0C@" 'Set default prompt.
Else P4 = "@" + UCase(P4) + "@"
End If
CurrentDate(CurCode) 'Put date into CurDate.
ChaStr1 = FormatDate(CurCode,"ddmmyyyy") 'Convert data into usable String.
CurDay = Left(ChaStr1,2) 'Current Day established, used for CurDate.
CurMonth = Mid(ChaStr1,3,2) 'Current Month established, used for CurDate.
CurYear = Mid(ChaStr1,5,4) 'Current Year established, used for CurDate.
'Following line codes Wildcat! date to DOS style date for comparisons.
CurDate = ((Val(CurYear)-1980)*512) + (Val(CurMonth)*32)+Val(CurDay)
If WCMailRoute = QWKRoute Then
ChaStr2 = "QWK2: Line #1 and Line #3 of QWK2HOLD.CFG MUST NOT be the same."
ActivityLog ChaStr2
Goto Finished
End If
'>>>----> End of Configuration file and variable setup.
'>>>----> Start of main program
QWKTotal = 0
Gosub QWKLook 'Check for existing packets.
MainProg: 'Place program modules return to.
CLS
If (User.SecLevel = SecPro1) or (User.SecLevel = SecPro2) Then
Print P4;"Unfortunately your present Security Level does not allow you"
Print P4;"the ability to use the QWK program at this time. Please"
Print P4;"return after your security Level has been changed."
WaitEnter : Print: End
End If
Print P1;"The operator of this BBS allows callers to temporarily store QWK mail"
Print P1;"packets on the system for up to ";P2;MaxAge;
If MaxAge > 1 then
Print P1;" days."
Else
Print P1;" day."
End If
Print
Print P3;"You should only turn this option on if you are using what is known as"
Print P3;"an Offline Mail Reader "P2;"and";P3" you have ";P2;"successfully";P3;" downloaded a QWK mail"
Print P3;"packet from this BBS."
Print
Print P1;"You currently have the Automatic QWK mail option turned ";P2;
NumInt2 = Val(Mid(QWKFlag,9,1))
If Trim(Left(User.Comment(NumInt2),8)) = "QWK2 ON" Then
Print "ON";P1;"."
Else
Print "OFF";P1;"."
End If 'End If Trim(Left.
NumInt1 = 0'Turn into 1 if a flag was found raised.
If Exists(QWKInbound + "QWK2MA1.FLG") Then
NumInt1 = 1
If MailProc1 <> "" Then
Print P4;MailProc1
Else
Print P4;"Mail Flag #1 is flying high at this time."
End If 'End of message1.
End If 'End of flag1.
If Exists(QWKInbound + "QWK2MA2.FLG") Then
NumInt1 = 1
If MailProc2 <> "" Then
Print P4;MailProc2
Else
Print P4;"Mail Flag #2 is flying high at this time."
End If 'End of message2.
End If 'End of flag2.
If Exists(QWKInbound + "QWK2MA3.FLG") Then
NumInt1 = 1
If MailProc3 <> "" Then
Print P4;MailProc3
Else
Print P4;"Mail Flag #3 is flying high at this time."
End If 'End of message3.
End If 'End of flag3.
If Exists(QWKInbound + "QWK2MA4.FLG") Then
NumInt1 = 1
If MailProc4 <> "" Then
Print P4;MailProc4
Else
Print P4;"Mail Flag #4 is flying high at this time."
End If 'End of message4.
End If 'End of flag4.
If Exists(QWKInbound + "QWK2MA5.FLG") Then
NumInt1 = 1
If MailProc5 <> "" Then
Print P4;MailProc5
Else
Print P4;"Mail Flag #5 is flying high at this time."
End If 'End of message5.
End If 'End of flag5.
Print
If Trim(Left(User.Comment(Val(Mid(QWKFlag,9,1))),8)) = "QWK2 ON" Then
If NumInt1 = 1 Then
Print P1;"If you are still ""Online"" when your QWK Packet(s) are due to be made"
Print P1;"then yours will be skipped till the next time mail is processed."
Print
Delay 3
End If
Else 'QWK2 is OFF
If NumInt1 = 1 Then 'Flag is still raised.
Delay 3 'Add delay so user can read flag message.
End If
End If
If QWKTotal > 0 Then 'Tell the user about existing packets.
Print P1;"You have ";P2;QWKTotal;P1;" mail packet";
If QWKTotal > 1 Then
Print "s";
End If 'If QWKTotal > 1.
Print " for a total of ";P3;Int(Size/100);P1;" Kbytes."
Else 'No packets are on hold.
Print P4;"There are no QWK mail packets on hold for you at this time."
End If 'End if QWKTotal.
Print
Print P3;"You have the following options available at this time."
Print
If User.Xpert = 0 Then 'If a novice then show text.
Print P1;"[";P2;"C";P1;"]heck on existing mail packets being held for you."
Print P1;"[";P2;"T";P1;"]urn On\Off the automatic creation of mail packets."
Print P1;"[";P2;"I";P1;"]nformation about automatic creation of mail packets."
Print P1;"[";P2;"U";P1;"]pload replies from your QWK mail reader."
Print P1;"[";P2;"Q";P1;"]uit back to the previous menu."
End If 'Only show above if Novice mode is on.
If User.Xpert = 1 Then 'Regular User.
Print P1;"[";P2;"C";P1;"]heck, [";P2;"T";P1;"]urn On/Off, [";P2;"I";P1;"]nformation, [";P2;"U";P1;"]pload, [";P2;"Q";P1;"]uit"
End If
Print
ChaStr2 = InputMask(P1+"QWK2: [ C T I U Q ] --> ","X","")
ChaStr2 = Ucase(ChaStr2)
If ChaStr2 = "C" then Gosub QWKLook: Goto MainProg
If ChaStr2 = "T" then Gosub QWKNow: Goto MainProg
If ChaStr2 = "I" then Gosub QWKMore: Goto MainProg
If ChaStr2 = "U" then Gosub QWKUpload: Goto MainProg
If ChaStr2 = "Q" then End
Goto MainProg
'If ChaStr2 = "R" or anything else then end this program.
End 'End of main program
'>>>----> End of Main program.
'>>>----> Start of QWKNow subroutine.
QWKNow:
Print
NumInt2 = Val(Mid(QWKFlag,9,1))
If Trim(Left(User.Comment(NumInt2),8)) = "QWK2 ON" Then
Print P1;"You account has the automatic creation of mail packets turned ";P2;"On."
Else
Print P1;"Your account has the automatic creation of mail packets turned ";P2;"Off."
End If 'End of above If.
Print
ChaStr1 =InputMask(P1+"Do you want mail packets premade for you?","Y")
NumInt2 = Val(Mid(QWKFlag,9,1))
If UCase(ChaStr1) = "Y" Then
User.Comment(NumInt2) = "QWK2 ON " 'Yes reply
Print P1;"Automatic QWK making has been turned ";P2;"on";P1;"."
Else
User.Comment(NumInt2) = "QWK2 OFF " 'If Answer was No
Print P1;"Automatic QWK making has been turned ";P2;"off";P1;"."
End If 'End of If InputYesNo.
WaitEnter
Return
'>>>----> End of QWKNow subroutine.
'>>>----> Start of QWKMore subroutine.
QWKMore:
ChaStr2 = ProgPath + "QWK2HOLD.TXT"
If Exists(ChaStr2) Then
Print P1
DisplayTextFile(ChaStr2)
Else
Print P2;"QWK2HOLD";P1;", created by James Mardis (Fidonet 1:322/746)"
Print
Print
Print P1;"Your Sysop has activated the option that will allow callers who are"
Print P1;"using what is known as a ""Offline Mail Reader"" to automatically"
Print P1;"have QWK mail packets made for them after inbound mail is processed."
Print
Print P1;"Programs of this type allow a caller to download any mail they have"
Print P1;"in one short call to the BBS. They then can take all the time they"
Print P1;"want to read and reply to the mail with out having to use up thier"
Print P1;"alloted time on the BBS. When they have finished with any replies"
Print P1;"they call the BBS back and upload all of them in one quick upload."
WaitEnter
Print
Print P1;"Your Sysop has granted you the ability to have QWK mail packets"
Print P1;"made automatically for you. These QWK mail packets can only be"
Print P1;"left on the system for ";P2;MaxAge;P1;
If MaxAge > 1 then
Print P1;" days."
Else
Print P1;"day."
End If 'End of If MaxAge > 1.
Print
Print P1;"If you leave QWK mail on the system longer than this limit the"
Print P1;"system will turn off this option for your account. You will be"
Print P1;"sent an automatic notice advising you that you have over age mail"
Print P1;"packets. 15 days after the warning ";P2;"all";P1;" of your remaining QWK"
Print P1;"mail packets will be deleted."
Print
Print P1;"You can later turn this option back on if you so desire."
WaitEnter
Print
Print P1;"Your system administrator has set the following values for this program:"
Print
Print P1;"Warning message will be sent if packets are older then [";P2;MaxAge;P1;"] ";
If MaxAge > 1 Then
Print P1;"days."
Else
Print P1;"day."
End If 'End of MaxAge > 1.
Print P1;"Maximum number of QWK Packets in storage, [";P2;MaxPacket;P1;"] at one time."
Print P1;"If the total size of existing packets exceed [";P2;Int(MaxSize/100);P1;"] Kbytes"
Print P1;"then no new packets will be made."
Print
End If
WaitEnter
Return
'>>>----> End of QWKMore subroutine.
'>>>----> Start of QWKUpload
QWKUpload:
If Trim(Left(User.Comment(NumInt2),8)) = "QWK2 ON" Then
PushCommand "U"
ChaStr2 = "WCMAIL.EXE ":Shell ChaStr2
Else
Print
Print P1;"This menu option is only active if you have the Automatic"
Print P1;"creation of QWK packets turned on."
Print
WaitEnter
End If
Return
'>>>----> End of QWKUpload
'>>>----> Start QWKLook subroutine.
QWKLook:
'Do clean up in case packets don't start with A or are out of sequence.
NumInt1 = 0
FindQWK = 0
Do While FindQWK < MaxPacket
NewFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(NumInt1 + 65)
OldFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
If Exists(OldFile) Then 'OldFile already exists so go add one and go on.
FindQWK = FindQWK + 1
NumInt1 = NumInt1 + 1
If OldFile <> NewFile Then 'OldFile exists but does it match Newfile
Name OldFile as NewFile' Nope, rename Oldfile to fill gap.
End If 'End of If Oldfile <> Newfile
ELSE 'Oldfile was not found, increment and go thru loop again.
FindQWK = FindQWK + 1
End If 'End of If Exists(Oldfile)
Loop
'Main section of QWKLook begins here.
Size = 0
NewFile = QWKRoute + Str(User.UserID) + ".QWA"
OldFile = WCMailRoute + Str(User.UserID) + ".QWK"
If Exists(NewFile) or Exists(OldFile) Then
FindQWK = 0
Print
Print P1;"At least one mail packet is on hold, looking for others."
Print
Print P1;" FileName Size Age";P2
Do While FindQWK < MaxPacket + 1
Newfile = QWKRoute + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
If Exists(NewFile) Then 'Checking for existing stored packet.
FindFirst(NewFile,0,FileSearch)
FileSize=FileSearch.Size
FileDos=FileSearch.DosDate
Size = Size + FileSearch.Size
Print P2;LeftPad(UCase(Trim(MakeWild.PacketId)) + ".QW" + Chr(FindQWK + 65),8);
Print P3;LeftPad(Str(Int(FileSearch.Size/100)),8);"K";
Print P2;LeftPad(Str(CurDate - FileDos),5);
If CurDate - FileDos = 1 Then
Print P1;" Day"
Else 'Part of If CurDate - FileDos = 1
If CurDate - FileDos = 0 Then
Print P1;" Today"
Else 'Part of If CurDate - FileDos = 0
Print P1;" Days"
End If 'End if age = 0
End If 'End of If age = 1
Else 'Ran out of files to check in QWK2.
Exit Do 'Early escape out of the Do While loop.
End If 'Done checking for existing packet.
FindQWK = FindQWK + 1
If FindQWK > QWKTotal Then 'Correct total if needed.
QWKTotal = QWKTotal + 1'Existing packet count incremented.
End If
Loop' Run thru the Do While loop again.
'Look for orphaned QWK packets the user may have made with WCMAIL.
ChaStr1 = QWKRoute + Str(User.UserID)'Partial Newfile.
If QWKTotal >= 26 then 'If number of packets already at limit.
NumInt1 = 48' Make packet end in zero.
Else 'Go look for more packets.
NumInt1 = QWKTotal + 1'Otherwise make it next letter in alphabet.
End If 'Done determining new packets for NewFile construction.
NewFile = ChaStr1 + ".QW" + Chr(NumInt1) 'Newfile variable.
OldFile = WCMailRoute + Str(User.UserID) + ".QWK" 'OldFile Variable.
If Exists(OldFile) Then 'Get ready to relocate WCMAIL QWK Packet.
CopyFile(OldFile,NewFile) 'Copy WCMAIL QWK packet to storage.
ChaStr1 = Str(User.UserID) + ".QWK"
DeleteFile(ChaStr1,WCMailZip,1) 'Delete old QWK file from disk & records.
QWKTotal = QWKTotal + 1'Increment total number of stored packets.
FindFirst(NewFile,0,FileSearch) 'Establish FileSearch variable.
FileSize=FileSearch.Size'Determine packet file size.
Size = Size + FileSearch.Size 'Increment size of stored packets.
Print LeftPad(FileSearch.Name,12) + LeftPad(Str(Int(FileSearch.Size/100)),14)
End If 'WCMail Packet has been moved to storage.
ELSE 'No packets found in storage.
Return
End If 'Finished loading variables and displaying any existing packets.
Print P1;"You have ";P2;QWKTotal;P1;" mail packet";
If QWKTotal > 1 Then Print "s";
Print" for a total of ";P3;Int(Size/100);P1;" Kbytes."
If QWKTotal > 0 Then
Print P1;"The following choices are available for your use:"
Print P1;"[";P2;"A";P1;"]ll packets downloaded now and continue."
Print P1;"[";P2;"D";P1;"]ownload all packets now and log off of the BBS."
Print P1;"[";P2;"F";P1;"]irst, download only first packet and continue."
Print P1;"[";P2;"N";P1;"]o packets downloaded at this time, continue with BBS."
Print
ChaStr2 = InputMask(P1+"Choose Download ["+P2+"A"+P1+"]ll, ["+P2+"D"+P1+"]ownload & Goodbye, ["+P2+"F"+P1+"]irst, or ["+P2+"N"+P1+"]one ","X","A")
ChaStr2 = UCase(ChaStr2)
UKey = ChaStr2 'Set Ukey value from user's input.
If Chastr2 = "N" Then Print: Return'Abort out of here.
If ChaStr2 = "A" Then'Going for the whole hog.
If QWKTotal > 1 Then
Print P1;"The mail packets will be sent in sequence, one right after the other."
Print P3;"There will be a short pause between packets, please be patient."
End If 'End of If QWKTotal.
End If 'End checking for All response.
End If 'End of If QWKTotal > 1
If (Local) Then
Print
Print P1;"Enter the path where you want your mail packets to wind up."
Print P1;"Please use the following format shown in example: ";P2;"C:\READER";P1;"."
QWKSysop = InputMask("-->","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")'Get local Sysop mail path.
If QWKSysop = "" Then Return
QWKSysop = Trim(UCase(QWKSysop)) 'Make it Uppercase & trim spaces.
IF Mid(QWKSysop,2,2) <> ":\" Then BadEnd = 21: Gosub Problem
IF Right(QWKSysop,1) = "\" Then 'Verify no ending backslash.
NumInt1 = Len(QWKSysop) - 1
QWKSysop = Left(QWKSysop,NumInt1) 'Slash was removed
End If 'End of QWKSysop slash check.
End If 'End of If (Local)
Print
If UKey <> "A" Then
ChaStr2 = InputMask(P1+"Hit the Enter key to begin the file transfer or ["+P2+"A"+P1+"] to abort.","X")
If UCase(Left(ChaStr2,1)) = "A" then UKey = "": Return
End If 'If UKey <> "A"
QWKLeft = QWKTotal 'Load in how many packets a user needs to download.
For FindQWK = 0 to QWKTotal - 1
OldFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
ChaStr2 = TempPath
NewFile = ChaStr2 + UCase(Trim(MakeWild.PacketId)) + ".QW" + Chr(FindQWK + 65)
If (Local) then
If Len(QWKSysop) <= 20 Then PushCommand QWKSysop 'PushCommand 20 char limit.
End If'End of Local check.
CopyFile (OldFile,NewFile)' Move to temp. Can't use Name -> drive letter.
Del OldFile
If SendFile(NewFile) Then 'Goto else option if not a good send.
Del NewFile 'Delete file that was sucessfully sent.
ActivityLog "QWK2: File " + NewFile + " was downloaded successfully."
QWKLeft = QWKLeft - 1
Else
Print P4;" Mail transfer failed.";P1
CopyFile (NewFile,OldFile)' Rename and put file back in storage.
Del NewFile
ActivityLog "QWK2: " + NewFile + " was not downloaded successfully."
Exit For
End If 'End of Sendfile.
If Ukey = "F" Then
Print
ChaStr2 =InputMask(P1+"["+P2+"N"+P1+"]ext File, ["+P2+"S"+P1+"]top Downloading ","X","N")
If UCase(Left(ChaStr2,1)) = "S" Then
Exit For
End If'End of "S" check.
End If 'End of "F" check.
Next FindQWK
'Final Clean up
If Not(QWKLeft = QWKTotal) Then 'At least one mail packet was transferred.
NumInt1 = QWKTotal - QWKLeft' Determine how many are left in storage.
QWKTotal = QWKLeft 'Correct total value now cause something was downloaded.
For FindQWK = 0 to QWKLeft - 1
NewFile = Trim(QWKRoute) + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
OldFile = Trim(QWKRoute) + Str(User.UserID) + ".QW" + Chr(NumInt1 + 65)
Name OldFile As NewFile'Move names of left over packets to top.
NumInt1 = NumInt1 + 1
Next FindQWK
End If
'Load QWK2 value into user file.
NumInt2 = Val(Mid(QWKFlag,9,1))
ChaStr1 = Pad( UCase( Left( User.Comment(NumInt2),9) ) ,9) 'Load QWK ON/OFF.
User.Comment(Val(Mid(QWKFlag,9,1))) = ChaStr1 'Updated Values.
If UKey = "D" Then 'Quit BBS call when done.
Goodbye True 'Log off user.
End If 'If UKey = "D".
Return ' Return to mail program.
'>>>----> End of QWKLook subroutine
'>>>----> Start of Problem Goto
Problem: 'Come here if there is an error needing attention.
'Note: (Problem:) is used as a GoSub or a Goto depending on BadEnd #.
'Reserve BadEnd 1 - 20 for .CFG file checking
If BadEnd >= 0 and BadEnd <=19 Then 'Something wrong with configuation file.
CLS
Print
If BadEnd = 0 Then
Print P4;"The QWK2HOLD.CFG file was not located." 'Where is it.
Else
Print P1;"Line [";P2;BadEnd;P1;"] of the ";P2;"QWK2HOLD.CFG";P1;" has a problem." 'What line is bad.
End If 'End If BadEnd = 0
Print
Print P1;"The current values of your ";P2;"QWK2HOLD.CFG";P1;" file are";P2;":"
Print P1;"Line #1 = [";P2;WCMailRoute;P1;"]"
Print P1;"Line #2 = [";P2;WCMailZip;P1;"]"
Print P1;"Line #3 = [";P2;QWKRoute;P1;"]"
Print P1;"Line #4 = [";P2;QWKFlag;P1;"]"
Print P1;"Line #5 = [";P2;SecPro1;P1;"]"
Print P1;"Line #6 = [";P2;SecPro2;P1;"]"
Print P1;"Line #7 = [";P2;MaxPacket;P1;"]"
Print P1;"Line #8 = [";P2;MaxAge;P1;"]"
Print P1;"Line #9 = [";P2;MaxSize;P1;"]"
Print P1;"Line #10 = [";P2;MsgPlace;P1;"]"
Print P1;"Line #11 = [";P2;Mid(P1,2,2);P1;"]"
Print P1;"Line #12 = [";P2;Mid(P2,2,2);P1;"]"
Print P1;"Line #13 = [";P2;Mid(P3,2,2);P1;"]"
Print P1;"Line #14 = [";P2;Mid(P4,2,2);P1;"]"
Print P1;"Line #15 = [";P2;QWKInbound;P1;"]"
Print
Print P1;"This program will terminate after a 60 seconds pause."
Delay 60
End If 'End Error #1 - 19.
If BadEnd = 20 Then
Print
Print P1;"Your input did not make sense, you may not download your QWK"
Print P1;"packet at this time."
Print
WaitEnter
Return
End If
If BadEnd = 21 Then
Print
Print P1;"The path you supplied could not be located. Mail packet"
Print P1;"transfer can not take place at this time."
Print
WaitEnter
Return
End If
If BadEnd = 22 Then
ChaStr2 = "QWK2: User does not have QWK checking turned on."
ActivityLog ChaStr2
End If
If BadEnd = 23 Then
ChaStr2 = "QWK2: User did not meet security requirements for QWK2."
ActivityLog ChaStr2
End If
Goto Finished'If you wind up here something is wrong with the program.
'>>>----> End of Problem Goto
'>>>----> Come here at the end of the program.
Finished:
ChaStr2 = "QWK2: Program has ended at this time."
ActivityLog ChaStr2
End